Declare Sub cPushID Lib "mcvb4016.dll" (IDArray As Integer, ByVal nID As Integer)
Declare Sub cPopID Lib "mcvb4016.dll" (IDArray As Integer, ByVal nID As Integer)
Declare Sub cPopLastID Lib "mcvb4016.dll" (IDArray As Integer)
Declare Function cGetID Lib "mcvb4016.dll" (IDArray As Integer, ByVal nPosition As Integer) As Integer
Declare Sub cClearID Lib "mcvb4016.dll" (IDArray As Integer)
Declare Sub cChangeChars Lib "mcvb4016.dll" (Txt As String, CharSet As String, NewCharSet As String)
Declare Function cGetIni Lib "mcvb4016.dll" (ByVal AppName As String, ByVal szItem As String, ByVal szDefault As String, ByVal InitFile As String) As String
Declare Function cInsertBlocks Lib "mcvb4016.dll" (Txt As String, Insert As String) As String
Declare Function cLngMsgBox Lib "mcvb4016.dll" (ByVal nLanguage As Integer, ByVal Message As String, ByVal Button As Long, ByVal Title As String) As Integer
Declare Function cKillFileAll Lib "mcvb4016.dll" (ByVal lpFilename As String) As Integer
Declare Function cTimerClose Lib "mcvb4016.dll" (ByVal TimerHandle As Integer) As Integer
Declare Function cTimerOpen Lib "mcvb4016.dll" () As Integer
Declare Function cTimerRead Lib "mcvb4016.dll" (ByVal TimerHandle As Integer) As Long
Declare Function cTimerStart Lib "mcvb4016.dll" (ByVal TimerHandle As Integer) As Integer
#Else
Declare Sub cPushID Lib "mcvb4032.dll" (IDArray() As Integer, ByVal nID As Integer)
Declare Sub cPopID Lib "mcvb4032.dll" (IDArray() As Integer, ByVal nID As Integer)
Declare Sub cPopLastID Lib "mcvb4032.dll" (IDArray() As Integer)
Declare Function cGetID Lib "mcvb4032.dll" (IDArray() As Integer, ByVal nPosition As Integer) As Integer
Declare Sub cClearID Lib "mcvb4032.dll" (IDArray() As Integer)
Declare Sub cChangeChars Lib "mcvb4032.dll" (Txt As String, CharSet As String, NewCharSet As String)
Declare Function cGetIni Lib "mcvb4032.dll" (ByVal AppName As String, ByVal szItem As String, ByVal szDefault As String, ByVal InitFile As String) As String
Declare Function cInsertBlocks Lib "mcvb4032.dll" (Txt As String, Insert As String) As String
Declare Function cLngMsgBox Lib "mcvb4032.dll" (ByVal nLanguage As Integer, ByVal Message As String, ByVal Button As Long, ByVal Title As String) As Integer
Declare Function cKillFileAll Lib "mcvb4032.dll" (ByVal lpFilename As String) As Integer
Declare Function cTimerClose Lib "mcvb4032.dll" (ByVal TimerHandle As Integer) As Integer
Declare Function cTimerOpen Lib "mcvb4032.dll" () As Integer
Declare Function cTimerRead Lib "mcvb4032.dll" (ByVal TimerHandle As Integer) As Long
Declare Function cTimerStart Lib "mcvb4032.dll" (ByVal TimerHandle As Integer) As Integer
#End If
'Don't change any variables and their value below
Const ID_ITEMS = 16
Type tagERRORHANDLERtype
ModuleName As String * 256
RoutineHandle As String * 4
RoutineName As String * 76
CrLf As String * 2
End Type
Type tagTRACERtype
StartStop As String * 1
RoutineHandle As Integer
End Type
Type tagPROFILERtype
ModuleName As String * 256
RoutineHandle As String * 4
RoutineName As String * 76
TimeCounter As Long
TotalCall As Long
TotalTime As Long
MinimumTime As Long
MaximumTime As Long
Dummy As String * 10
CrLf As String * 2
End Type
Dim TotalRoutines As Integer
Dim ActualTrace As Long
Dim OldStartRoutine As Integer
Dim OldStopRoutine As Integer
Dim FileTR As String
Dim FilePF As String
Dim chanFileTR As Integer
Dim chanFilePF As Integer
Dim FileLNG As String
Dim FileHND As String
Dim FileLOG As String
Dim IDArray(0 To ID_ITEMS) As Integer
Dim Language As Integer
Dim AutoLog As Integer
Dim WaitingTimeForReaction As Integer
Dim DefaultButton As Integer
Dim DisplayOnline As Integer
Dim TraceProfile As Integer
Dim TotalSameHandle As Long
Dim LastHandle As Integer
Dim ChanHandle As Integer
Dim OldChanHandle As Integer
Dim tagERRORHANDLER As tagERRORHANDLERtype
Dim tagTRACER As tagTRACERtype
Dim tagPROFILER As tagPROFILERtype
Sub mcClearID()
#If Win16 Then
Call cClearID(IDArray(0))
#Else
Call cClearID(IDArray)
#End If
End Sub
Function mcGetID(nPos As Integer)
#If Win16 Then
mcGetID = cGetID(IDArray(0), nPos)
#Else
mcGetID = cGetID(IDArray, nPos)
#End If
End Function
Function mcGetLanguageID(LanguageID As Integer) As String
Dim RetLanguage As String
Select Case LanguageID
Case VB_LNG_FRENCH
RetLanguage = "VFR"
Case VB_LNG_DUTCH
RetLanguage = "VNL"
Case VB_LNG_GERMAN
RetLanguage = "VDE"
Case VB_LNG_ENGLISH
RetLanguage = "VUK"
Case VB_LNG_ITALIAN
RetLanguage = "VIT"
Case VB_LNG_SPANISH
RetLanguage = "VSP"
Case VB_LNG_CATALAN
RetLanguage = "VCA"
Case VB_LNG_POLISH
RetLanguage = "VPO"
Case Else
RetLanguage = "VUK"
End Select
If (LanguageID > 0) Then
Language = LanguageID
Else
Language = VB_LNG_ENGLISH
End If
mcGetLanguageID = RetLanguage
End Function
Function mcIDErrorHandler(nErr As Integer) As Integer
' check if this a correct Error passed
If (nErr = 0) Then
'if no, resume next
mcIDErrorHandler = True
Exit Function
End If
Dim RoutineCount As Integer
Dim RoutineNumber As Integer
Dim RoutineStack As String
Dim TotalRoutines As Integer
Dim BlankLines As Integer
Dim Chan As Integer
Dim StopExit As Integer
Dim TimeOut As Long
Dim ButtonsConfig As Integer
Dim ErrorTitle As String
' some initializations
RoutineStack = ""
TotalRoutines = 0
BlankLines = 0
StopExit = False
ButtonsConfig = 0
ErrorTitle = ""
RoutineStack = RoutineStack + mcReadText("0", "")
' find the next valid unused file number.
Chan = FreeFile
' open the file with the definition of each routines (file must be in the WINDOWS directory)
Close #Chan
Open FileHND For Random Shared As #Chan Len = Len(tagERRORHANDLER)
' get the stack of the routines
For RoutineCount = 0 To ID_ITEMS
' get the number of the routine
RoutineNumber = mcGetID(RoutineCount)
' if there a valid routine number
If (RoutineNumber > 0) Then
' yes, read the definition of the routine
Get #Chan, RoutineNumber, tagERRORHANDLER
' form the stack of the routines founden to display
